home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Rkrm / Graphics_Libraries / Text / MeasureText.e < prev   
Encoding:
Text File  |  1995-09-20  |  6.6 KB  |  191 lines
  1. -> MeasureText.e
  2.  
  3. ->>> Header (globals)
  4. MODULE 'asl',
  5.        'diskfont',
  6.        'graphics/rastport',
  7.        'graphics/text',
  8.        'intuition/intuition',
  9.        'intuition/screens',
  10.        'libraries/asl',
  11.        'other/split'
  12.  
  13. ENUM ERR_NONE, ERR_ARGS, ERR_ASL, ERR_FONT, ERR_KICK, ERR_LIB, ERR_OPEN,
  14.      ERR_READ, ERR_WIN
  15.  
  16. RAISE ERR_ASL  IF AllocAslRequest()=NIL,
  17.       ERR_FONT IF OpenDiskFont()=NIL,
  18.       ERR_KICK IF KickVersion()=FALSE,
  19.       ERR_LIB  IF OpenLibrary()=NIL,
  20.       ERR_OPEN IF Open()=NIL,
  21.       ERR_READ IF Read()<0,
  22.       ERR_WIN  IF OpenWindowTagList()=NIL
  23.  
  24. CONST BUFSIZE=32000  -> E-Note: 32768 is too big for a static ARRAY
  25.  
  26. DEF buffer[BUFSIZE]:ARRAY, myfile=NIL, wtbarheight,
  27.     fr=NIL:PTR TO fontrequester, myfont=NIL:PTR TO textfont,
  28.     w=NIL:PTR TO window, myrp:PTR TO rastport
  29. ->>>
  30.  
  31. ->>> PROC main()
  32. PROC main() HANDLE
  33.   DEF arglist:PTR TO LONG
  34.   KickVersion(37)  -> Run only on 2.0 machines
  35.   -> E-Note: use argSplit() to get argv-like list (minus command name)
  36.   IF NIL=(arglist:=argSplit()) THEN Raise(ERR_ARGS)
  37.   IF ListLen(arglist)=1  -> E-Note: replaces 'argc==2'
  38.     myfile:=Open(arglist[0], OLDFILE)  -> Open the file to print out.
  39.     diskfontbase:=OpenLibrary('diskfont.library', 37)
  40.     aslbase:=OpenLibrary('asl.library', 37)
  41.     fr:=AllocAslRequest(ASL_FONTREQUEST,  -> Open an ASL font requester.
  42.           -> Supply initial values for requester
  43.           [ASL_FONTNAME,   'topaz.font',
  44.            ASL_FONTHEIGHT, 11,
  45.            ASL_FONTSTYLES, FSF_BOLD OR FSF_ITALIC,
  46.            ASL_FRONTPEN,   1,
  47.            ASL_BACKPEN,    0,
  48.  
  49.            -> Give us all the gadgetry
  50.            ASL_FUNCFLAGS,  FONF_FRONTCOLOR OR FONF_BACKCOLOR OR
  51.                            FONF_DRAWMODE OR FONF_STYLES,
  52.            NIL])
  53.     -> Pop up the requester
  54.     IF AslRequest(fr, NIL)
  55.       -> Extract the font and display attributes from the fontrequest.
  56.       myfont:=OpenDiskFont([fr.attr.name,  fr.attr.ysize,
  57.                             fr.attr.style, fr.attr.flags]:textattr)
  58.       w:=OpenWindowTagList(NIL, [WA_SIZEGADGET,  TRUE,
  59.                                  WA_MINWIDTH,    200,
  60.                                  WA_MINHEIGHT,   200,
  61.                                  WA_DRAGBAR,     TRUE,
  62.                                  WA_DEPTHGADGET, TRUE,
  63.                                  WA_TITLE,       arglist[0],
  64.                                  NIL])
  65.       myrp:=w.rport
  66.       -> Figure out where the baseline of the uppermost line should be.
  67.       wtbarheight:=w.wscreen.barheight+myfont.baseline+2
  68.  
  69.       -> Set the font and add software styling to the text if I asked for it
  70.       -> in OpenFont() and didn't get it.  Because most Amiga fonts do not
  71.       -> have styling built into them (with the exception of the CG outline
  72.       -> fonts), if the user selected some kind of styling for the text, it
  73.       -> will to be added algorithmically by calling SetSoftStyle().
  74.       SetFont(myrp, myfont)
  75.       SetSoftStyle(myrp, Eor(fr.attr.style, myfont.style),
  76.                    FSF_BOLD OR FSF_UNDERLINED OR FSF_ITALIC)
  77.       SetDrMd(myrp, fr.drawmode)
  78.       SetAPen(myrp, fr.frontpen)
  79.       SetBPen(myrp, fr.backpen)
  80.       Move(myrp, w.wscreen.wborleft, wtbarheight)
  81.  
  82.       mainLoop()
  83.  
  84.       -> Short delay to allow user to see the text before it goes away.
  85.       Delay(25)
  86.     ELSE
  87.       WriteF('Request Cancelled\n')
  88.     ENDIF
  89.   ELSE
  90.     WriteF('Template: MeasureText <file name>\n')
  91.   ENDIF
  92. EXCEPT DO
  93.   IF w THEN CloseWindow(w)
  94.   IF myfont THEN CloseFont(myfont)
  95.   IF fr THEN FreeAslRequest(fr)
  96.   IF aslbase THEN CloseLibrary(aslbase)
  97.   IF diskfontbase THEN CloseLibrary(diskfontbase)
  98.   IF myfile THEN Close(myfile)
  99.   SELECT exception
  100.   CASE ERR_ARGS;  WriteF('Error: ran out of memory splitting arguments\n')
  101.   CASE ERR_ASL;   WriteF('Error: could not allocate ASL request\n')
  102.   CASE ERR_FONT;  WriteF('Error: could not open font\n')
  103.   CASE ERR_KICK;  WriteF('Error: requires V37+\n')
  104.   CASE ERR_LIB;   WriteF('Error: could not open required library\n')
  105.   CASE ERR_OPEN;  WriteF('Error: could not open file\n')
  106.   CASE ERR_READ;  WriteF('Error: Read() failed on file\n')
  107.   CASE ERR_WIN;   WriteF('Error: could not open window\n')
  108.   ENDSELECT
  109. ENDPROC
  110. ->>>
  111.  
  112. ->>> PROC mainLoop()
  113. PROC mainLoop()
  114.   DEF resulttextent:textextent, fit, actual, count, printable, crrts, aok=TRUE
  115.   -> While there's something to read, fill the buffer.
  116.   WHILE (actual:=Read(myfile, buffer, BUFSIZE)) AND aok
  117.     count:=0
  118.  
  119.     WHILE count<actual
  120.       crrts:=0
  121.       -> Skip non-printable characters, but account for newline characters.
  122.       WHILE ((buffer[count] < myfont.lochar) OR
  123.              (buffer[count] > myfont.hichar)) AND (count < actual)
  124.         -> Is this character a newline?  If it is, bump up the newline count.
  125.         IF buffer[count]=$0A THEN INC crrts
  126.         INC count
  127.       ENDWHILE
  128.  
  129.       IF crrts>0  -> If there were any newlines, be sure to display them.
  130.         Move(myrp, w.borderleft, myrp.cp_y+(crrts*(myfont.ysize+1)))
  131.         eop()  -> Did we go past the end of the page?
  132.       ENDIF
  133.  
  134.       printable:=count
  135.       -> Find the next non-printables.
  136.       WHILE (buffer[printable] >= myfont.lochar) AND
  137.             (buffer[printable] <= myfont.hichar) AND (printable < actual)
  138.         INC printable
  139.       ENDWHILE
  140.       -> Print the string of printable characters wrapping lines to the
  141.       -> beginning of the next line as needed.
  142.       WHILE count<printable
  143.         -> How many characters in the current string of printable characters
  144.         -> will fit between the rastport's current X position and the edge of
  145.         -> the window?
  146.         fit:=TextFit(myrp,            buffer+count,
  147.                      printable-count, resulttextent,
  148.                      NIL,             1,
  149.                      w.width-(myrp.cp_x+w.borderleft+w.borderright),
  150.                      myfont.ysize+1)
  151.         IF fit=0
  152.           -> Nothing else fits on this line, need to wrap to the next line
  153.           Move(myrp, w.borderleft, myrp.cp_y+myfont.ysize+1)
  154.         ELSE
  155.           Text(myrp, buffer+count, fit)
  156.           count:=count+fit
  157.         ENDIF
  158.         eop()
  159.       ENDWHILE
  160.  
  161.       IF CtrlC()  -> Did the user hit Ctrl-C?
  162.         aok:=FALSE
  163.         WriteF('Ctrl-C Break\n')
  164.         count:=BUFSIZE+1
  165.       ENDIF
  166.     ENDWHILE
  167.   ENDWHILE
  168. ENDPROC
  169. ->>>
  170.  
  171. ->>> PROC eop()
  172. PROC eop()
  173.   -> If we reached the page bottom, clear the rastport and move to the top.
  174.   IF myrp.cp_y > (w.height-(w.borderbottom+2))
  175.     Delay(25)
  176.     SetAPen(myrp, 0)
  177.     RectFill(myrp, w.borderleft, w.bordertop, w.width-(w.borderright+1),
  178.              w.height-(w.borderbottom+1))
  179.     SetAPen(myrp, 1)
  180.     Move(myrp, w.borderleft+1, wtbarheight)
  181.     SetAPen(myrp, fr.frontpen)
  182.   ENDIF
  183. ENDPROC
  184. ->>>
  185.  
  186. ->>> Version string
  187. vers:
  188.   CHAR 0, '$VER: MeasureText 37.1', 0
  189. ->>>
  190.  
  191.